---
-- title: Homework #1, Due Friday, January 20th
---

-- Preliminaries
-------------

-- Before starting this assignment:

-- 1. Read chapters 1 -- 3 of The Haskell School of Expression.
-- 2. Download and install the [Glasgow Haskell Compiler (GHC)](http://www.haskell.org/ghc/).
-- 3. Download the SOE code bundle from
   -- [the Haskell School of Expression page](/static/SOE.tar.gz).
-- 4. Verify that it works by changing into the `SOE/src` directory and
   -- running `ghci Draw.lhs`, then typing `main0` at the prompt:
 
-- ~~~
-- cd SOE/src
-- ghci Draw.lhs
-- *Draw> main0
-- ~~~

  -- You should see a window with some shapes in it.

-- **NOTE:** If you have trouble installing SOE, [see this page](soe-instructions.html)

-- 5. Download the required files for this assignment: [hw1.tar.gz](/static/hw1.tar.gz).
   -- Unpack the files and make sure that you can successfully run the main program (in `Main.hs`).
   -- We've provided a `Makefile`, which you can use if you like. You should see this output:

-- ~~~
-- Main: Define me!
-- ~~~

-- Haskell Formalities
-----------------

-- We declare that this is the Hw1 module and import some libraries:

module Hw1 where
import SOE
import Play
import XMLTypes

-- Part 1: Defining and Manipulating Shapes
--------------------------------------

-- You will write all of your code in the `hw1.lhs` file, in the spaces
-- indicated. Do not alter the type annotations --- your code must
-- typecheck with these types to be accepted.

-- The following are the definitions of shapes from Chapter 2 of SOE:

data Shape = Rectangle Side Side
           | Ellipse Radius Radius
           | RtTriangle Side Side
           | Polygon [Vertex]
           deriving Show

type Radius = Float 
type Side   = Float
type Vertex = (Float, Float)

-- 1. Below, define functions `rectangle` and `rtTriangle` as suggested
   -- at the end of Section 2.1 (Exercise 2.1). Each should return a Shape
   -- built with the Polygon constructor.

rectangle :: Side -> Side -> Shape
rectangle sideA sideB = Polygon [(0,0), (sideA,0), (sideA,sideB), (0,sideB)] 

rtTriangle :: Side -> Side -> Shape
rtTriangle sideA sideB = Polygon [(0,0), (sideA,0), (0, sideB)]

-- 2. Define a function

sides :: Shape -> Int
sides (Ellipse radius1 radius2)    = 42
sides (Rectangle side1 side2)  = sides (rectangle side1 side2)
sides (RtTriangle side1 side2) = sides (rtTriangle side1 side2)
sides (Polygon vertexList)    = if (length vertexList <= 2) 
                           then 0
                           else (length vertexList)

  -- which returns the number of sides a given shape has.
  -- For the purposes of this exercise, an ellipse has 42 sides,
  -- and empty polygons, single points, and lines have zero sides.

-- 3. Define a function

bigger :: Shape -> Float -> Shape
bigger (Ellipse r1 r2) e    = Ellipse ((sqrt e)*r1) ((sqrt e)*r2)
bigger (Rectangle s1 s2) e  = bigger (rectangle s1 s2) e
bigger (RtTriangle s1 s2) e = bigger (rtTriangle s1 s2) e
bigger (Polygon vList) e    = let sqrtE = sqrt e
                              in Polygon (map (\(a,b) -> (a*sqrtE,b*sqrtE)) vList) 

  -- that takes a shape `s` and expansion factor `e` and returns
  -- a shape which is the same as (i.e., similar to in the geometric sense)
  -- `s` but whose area is `e` times the area of `s`.

-- 4. The Towers of Hanoi is a puzzle where you are given three pegs,
   -- on one of which are stacked $n$ discs in increasing order of size.
   -- To solve the puzzle, you must move all the discs from the starting peg
   -- to another by moving only one disc at a time and never stacking
   -- a larger disc on top of a smaller one.
   
   -- To move $n$ discs from peg $a$ to peg $b$ using peg $c$ as temporary storage:
   
   -- 1. Move $n - 1$ discs from peg $a$ to peg $c$.
   -- 2. Move the remaining disc from peg $a$ to peg $b$.
   -- 3. Move $n - 1$ discs from peg $c$ to peg $b$.
   
   -- Write a function
   
hanoi :: Int -> String -> String -> String -> IO ()
hanoi n a b c = do mapM_ putStrLn $ hanoiList n a b c 

hanoiList :: Int -> String -> String -> String -> [String]
hanoiList 0 _ _ _ =  []
hanoiList n from to temp = (hanoiList (n-1) from temp to) ++ [stringMaker from to] ++ (hanoiList (n-1) temp to from)

stringMaker from to = "move disc from " ++ from ++ " to " ++ to

  -- that, given the number of discs $n$ and peg names $a$, $b$, and $c$,
  -- where a is the starting peg,
  -- emits the series of moves required to solve the puzzle.
  -- For example, running `hanoi 2 "a" "b" "c"`

  -- should emit the text

-- ~~~  
-- move disc from a to c
-- move disc from a to b
-- move disc from c to b
-- ~~~

-- Part 2: Drawing Fractals
----------------------

-- 1. The Sierpinski Carpet is a recursive figure with a structure similar to
   -- the Sierpinski Triangle discussed in Chapter 3:

-- ![Sierpinski Carpet](/static/scarpet.png)

-- Write a function `sierpinskiCarpet` that displays this figure on the
-- screen:

sierpinskiCarpet :: IO ()
sierpinskiCarpet = runGraphics (
         do w <- openWindow "HW1_2.1 Sierpinski Carpet" (300,300)
            sierpinskiRec w 50 300 256
            spaceClose w
       )
 
spaceClose :: Window -> IO ()
spaceClose w = do k <- getKeyChar w
                  if k ==' ' then closeWindow w
                              else spaceClose w

minSize1 :: Int
minSize1 = 2
 
fillRec :: Window -> Int -> Int -> Int -> IO ()
fillRec w x y size = drawInWindow w (withColor Blue 
                    (polygon [(x,y), (x+size,y), (x+size, y-size), (x,y-size)]))
 
sierpinskiRec :: Window -> Int -> Int -> Int -> IO ()
sierpinskiRec w x y size 
               = if size <= minSize1
                 then fillRec w x y size 
                 else let size2 = size `div` 3
                          y2 = y  - size2
                          y3 = y2 - size2
                          x2 = x  + size2
                          x3 = x2 + size2
                   in do sierpinskiRec w x  y  size2
                         sierpinskiRec w x  y2 size2
                         sierpinskiRec w x  y3 size2
                         sierpinskiRec w x2 y  size2
                         sierpinskiRec w x2 y3 size2
                         sierpinskiRec w x3 y  size2
                         sierpinskiRec w x3 y2 size2
                         sierpinskiRec w x3 y3 size2

-- Note that you either need to run your program in `SOE/src` or add this
-- path to GHC's search path via `-i/path/to/SOE/src/`.
-- Also, the organization of SOE has changed a bit, so that now you use
-- `import SOE` instead of `import SOEGraphics`.

-- 2. Write a function `myFractal` which draws a fractal pattern of your
   -- own design.  Be creative!  The only constraint is that it shows some
   -- pattern of recursive self-similarity.

myFractal :: IO ()
myFractal = runGraphics (
         do w <- openWindow "HW1_2.2 My Fractal" (600,600)
            sierpinskiCircle w 300 300 256 White
            spaceClose w
       )

minSize2 :: Int 
minSize2 = 8

fillCircle w x y r color = drawInWindow w (withColor color 
                     (ellipse (x-r,y-r) (x+r,y+r)))
 
sierpinskiCircle w x y r color
                = if r <= minSize2
                  then fillCircle w x y r color
                  else 
                    let r2 = r `div` 2
                        color2 = if (color == White) then Blue else White 
                    in do fillCircle w x y r color
                          sierpinskiCircle w (x+r2) y r2 color2
                          sierpinskiCircle w (x-r2) y r2 color2
                          sierpinskiCircle w x (y+r2) r2 color2
                          sierpinskiCircle w x (y-r2) r2 color2

-- Part 3: Transforming XML Documents
--------------------------------

-- First, a warmup:

-- 1. Read chapters 5 and 7 of SOE.

-- 2. Do problems 5.3, 5.5, 5.6, 7.1, and 7.2 from SOE, and turn them
   -- is as part of the source code you create below.

   -- Your `maxList` and `minList` functions may assume that the lists
   -- they are passed contain at least one element.

lengthNonRecrusive :: [a] -> Int
lengthNonRecrusive = foldr (\x y -> y + 1 ) 0

doubleEach :: [Int] -> [Int]
doubleEach [] = []
doubleEach (x:xs)= 2 * x : doubleEach xs

doubleEachNonRecursive :: [Int] -> [Int]
doubleEachNonRecursive [] = []
doubleEachNonRecursive x = map (\y -> 2 * y) x

pairAndOne :: [Int] -> [(Int, Int)]
pairAndOne [] = []
pairAndOne (x:xs) = ( x , x + 1 ):(pairAndOne xs)

pairAndOneNonRecursive :: [Int] -> [(Int, Int)]
pairAndOneNonRecursive x = map (\y -> ( y , y + 1 )) x 

addEachPair :: [(Int, Int)] -> [Int]
addEachPair [] = []
addEachPair ((x , y):xs) = ( x + y ):(addEachPair xs)

addEachPairNonRecursive :: [(Int, Int)] -> [Int]
addEachPairNonRecursive = map (\(x, y) -> ( x + y ))

minList :: [Int] -> Int
minList [] =  error " no element in list ! "
minList [x] =  x
minList (x:xs) =  let g = minList xs in 
					if x < g then x else g

minListNonRecursive :: [Int] -> Int
minListNonRecursive = foldr min (2 ^ 29 - 1)

maxList :: [Int] -> Int
maxList [] =  error " no element in list ! "
maxList [x] =  x
maxList (x:xs) =  let g = maxList xs in 
					if x > g then x else g

maxListNonRecursive :: [Int] -> Int
maxListNonRecursive = foldr max 0

data Tree a = Leaf a | Branch (Tree a) (Tree a)
              deriving (Show, Eq)

fringe :: Tree a -> [a]
fringe (Leaf x) = [x]
fringe (Branch t1 t2) = fringe t1 ++ fringe t2

treeSize :: Tree a -> Int
treeSize (Leaf x) = 1
treeSize (Branch t1 t2) = treeSize t1 + treeSize t2

treeHeight :: Tree a -> Int
treeHeight (Leaf x) = 0
treeHeight (Branch t1 t2) = 1 + max (treeHeight t1) (treeHeight t2)

data InternalTree a = ILeaf | IBranch a (InternalTree a) (InternalTree a)
                      deriving (Show, Eq)

takeTree :: Int -> InternalTree a -> InternalTree a
takeTree 0 tree = ILeaf
takeTree n ILeaf = ILeaf
takeTree n (IBranch a tree1 tree2) = IBranch a (takeTree (n - 1) tree1) (takeTree (n - 1) tree2)


takeTreeWhile :: (a -> Bool) -> InternalTree a -> InternalTree a
takeTreeWhile boolFunc ILeaf = ILeaf
takeTreeWhile boolFunc (IBranch a tree1 tree2) = if (boolFunc a)
			then IBranch a (takeTreeWhile boolFunc tree1) (takeTreeWhile boolFunc tree2)
			else ILeaf
 
-- Write the function map in terms of foldr:

myMap :: (a -> b) -> [a] -> [b]
myMap op list = foldr (\x a -> (op x):a ) [] list

-- The rest of this assignment involves transforming XML documents.
-- To keep things simple, we will not deal with the full generality of XML,
-- or with issues of parsing. Instead, we will represent XML documents as
-- instances of the following simpli?ed type:

-- ~~~~
-- data SimpleXML =
   -- PCDATA String
 -- | Element ElementName [SimpleXML]
 -- deriving Show

-- type ElementName = String
-- ~~~~

-- That is, a `SimpleXML` value is either a `PCDATA` ("parsed character
-- data") node containing a string or else an `Element` node containing a
-- tag and a list of sub-nodes.

-- The file `Play.hs` contains a sample XML value. To avoid getting into
-- details of parsing actual XML concrete syntax, we'll work with just
-- this one value for purposes of this assignment. The XML value in
-- `Play.hs` has the following structure (in standard XML syntax):

-- ~~~
-- <PLAY>
  -- <TITLE>TITLE OF THE PLAY</TITLE>
  -- <PERSONAE>
    -- <PERSONA> PERSON1 </PERSONA>
    -- <PERSONA> PERSON2 </PERSONA>
    -- ... -- MORE PERSONAE
    -- </PERSONAE>
  -- <ACT>
    -- <TITLE>TITLE OF FIRST ACT</TITLE>
    -- <SCENE>
      -- <TITLE>TITLE OF FIRST SCENE</TITLE>
      -- <SPEECH>
        -- <SPEAKER> PERSON1 </SPEAKER>
        -- <LINE>LINE1</LINE>
        -- <LINE>LINE2</LINE>
        -- ... -- MORE LINES
      -- </SPEECH>
      -- ... -- MORE SPEECHES
    -- </SCENE>
    -- ... -- MORE SCENES
  -- </ACT>
  -- ... -- MORE ACTS
-- </PLAY>
-- ~~~

-- * `sample.html` contains a (very basic) HTML rendition of the same
  -- information as `Play.hs`. You may want to have a look at it in your
  -- favorite browser.  The HTML in `sample.html` has the following structure
  -- (with whitespace added for readability):
  
-- ~~~
-- <html>
  -- <body>
    -- <h1>TITLE OF THE PLAY</h1>
    -- <h2>Dramatis Personae</h2>
    -- PERSON1<br/>
    -- PERSON2<br/>
    -- ...
    -- <h2>TITLE OF THE FIRST ACT</h2>
    -- <h3>TITLE OF THE FIRST SCENE</h3>
    -- <b>PERSON1</b><br/>
    -- LINE1<br/>
    -- LINE2<br/>
    -- ...
    -- <b>PERSON2</b><br/>
    -- LINE1<br/>
    -- LINE2<br/>
    -- ...
    -- <h3>TITLE OF THE SECOND SCENE</h3>
    -- <b>PERSON3</b><br/>
    -- LINE1<br/>
    -- LINE2<br/>
    -- ...
  -- </body>
-- </html>
-- ~~~

-- You will write a function `formatPlay` that converts an XML structure
-- representing a play to another XML structure that, when printed,
-- yields the HTML speci?ed above (but with no whitespace except what's
-- in the textual data in the original XML).

formatPlay :: SimpleXML -> SimpleXML
formatPlay (Element "PLAY" xmlList) = Element "html" [Element "body" (mapAndMerge tagPlay xmlList)]
formatPlay other = error "Format wrong!"

mapAndMerge :: (a -> [b]) -> [a] -> [b]
mapAndMerge f list = foldr (\x a -> (f x) ++ a) [] list

tagPlay :: SimpleXML -> [SimpleXML]
tagPlay (Element "TITLE" pcdata) = [Element "h1" pcdata]
tagPlay (Element "PERSONAE" xmlList) = (Element "h2" [PCDATA "Dramatis Personae"]) : (mapAndMerge tagPersonae xmlList)
tagPlay (Element "ACT" xmlList) = mapAndMerge tagAct xmlList
tagPlay other = error "tagPlay"

tagPersonae :: SimpleXML -> [SimpleXML]
tagPersonae (Element "PERSONA" pcdata) = pcdata ++ [(Element "br" [])]
tagPersonae other = error "tagPersonae"

tagAct :: SimpleXML -> [SimpleXML]
tagAct (Element "TITLE" pcdata) = [Element "h2" pcdata]
tagAct (Element "SCENE" xmlList) = mapAndMerge tagScene xmlList

tagScene :: SimpleXML -> [SimpleXML]
tagScene (Element "TITLE" pcdata) = [Element "h3" pcdata]
tagScene (Element "SPEECH" xmlList) = mapAndMerge tagSpeech xmlList

tagSpeech :: SimpleXML -> [SimpleXML]
tagSpeech (Element "SPEAKER" pcdata) = [Element "b" pcdata] ++ [(Element "br" [])]
tagSpeech (Element "LINE" pcdata) = pcdata ++ [(Element "br" [])]



-- The main action that we've provided below will use your function to
-- generate a ?le `dream.html` from the sample play. The contents of this
-- ?le after your program runs must be character-for-character identical
-- to `sample.html`.

mainXML = do writeFile "dream.html" $ xml2string $ formatPlay play
             testResults "dream.html" "sample.html"
-- >
firstDiff :: Eq a => [a] -> [a] -> Maybe ([a],[a])
firstDiff [] [] = Nothing
firstDiff (c:cs) (d:ds) 
     | c==d = firstDiff cs ds 
     | otherwise = Just (c:cs, d:ds)
firstDiff cs ds = Just (cs,ds)

testResults :: String -> String -> IO ()
testResults file1 file2 = do 
  f1 <- readFile file1
  f2 <- readFile file2
  case firstDiff f1 f2 of
    Nothing -> do
      putStr "Success!\n"
    Just (cs,ds) -> do
      putStr "Results differ: '"
      putStr (take 20 cs)
      putStr "' vs '"
      putStr (take 20 ds)
      putStr "'\n"

-- Important: The purpose of this assignment is not just to "get the job
-- done" --- i.e., to produce the right HTML. A more important goal is to
-- think about what is a good way to do this job, and jobs like it. To
-- this end, your solution should be organized into two parts:

-- 1. a collection of generic functions for transforming XML structures
   -- that have nothing to do with plays, plus

-- 2. a short piece of code (a single de?nition or a collection of short
   -- de?nitions) that uses the generic functions to do the particular
   -- job of transforming a play into HTML.

-- Obviously, there are many ways to do the ?rst part. The main challenge
-- of the assignment is to ?nd a clean design that matches the needs of
-- the second part.

-- You will be graded not only on correctness (producing the required
-- output), but also on the elegance of your solution and the clarity and
-- readability of your code and documentation.  Style counts.  It is
-- strongly recommended that you rewrite this part of the assignment a
-- couple of times: get something working, then step back and see if
-- there is anything you can abstract out or generalize, rewrite it, then
-- leave it alone for a few hours or overnight and rewrite it again. Try
-- to use some of the higher-order programming techniques we've been
-- discussing in class.

-- Submission Instructions
---------------------

-- * If working with a partner, you should both submit your assignments
  -- individually.
-- * Make sure your `hw1.lhs` is accepted by GHC without errors or warnings.
-- * Attach your `hw1.hs` file in an email to `cse230@goto.ucsd.edu` with the
  -- subject "HW1" (minus the quotes).
  -- *This address is unmonitored!*

-- Credits
-----

-- This homework is essentially Homeworks 1 & 2 from
-- <a href="http://www.cis.upenn.edu/~bcpierce/courses/552-2008/index.html">UPenn's CIS 552</a>.
